Plinko Online Analysis

1 SETUP

1.1 Load libraries

1.2 Set options

2 DATA

2.1 Load and structure data

3 STATS

3.1 Trial selection

3.2 Fit separate models to each participant

3.2.1 Children

model_selection = c("adult_vision", "adult_vision_sound", "baseline", "matching")

df.fits = df.choices %>% 
  mutate(answer = factor(answer, levels = 1:3)) %>% 
  left_join(df.predictions %>% 
              select(world, answer, all_of(model_selection)),
            by = c("world", "answer")) %>% 
  mutate(across(all_of(model_selection), ~ ifelse(. == 0, 0.01, .))) %>% 
  group_by(age, participant) %>% 
  summarize(across(all_of(model_selection), ~ exp(sum(log(.))))) %>% 
  ungroup() %>% 
  rowwise() %>% 
  mutate(sum = sum(c_across(all_of(model_selection))),
         across(all_of(model_selection), ~ . / sum)) %>% 
  select(-sum)

3.2.2 Adults

model_selection = c("adult_vision", "adult_vision_sound", "baseline", "matching")

df.fits.adults = df.adults %>% 
  mutate(answer = as.factor(answer)) %>% 
  filter(world %in% unique(df.choices$world)) %>% 
  left_join(df.predictions %>% 
              select(world, answer, all_of(model_selection)),
            by = c("world", "answer")) %>% 
  mutate(across(all_of(model_selection), ~ ifelse(. == 0, 0.01, .))) %>% 
  group_by(experiment, participant) %>% 
  summarize(across(all_of(model_selection), ~ exp(sum(log(.))))) %>% 
  ungroup() %>% 
  rowwise() %>% 
  mutate(sum = sum(c_across(all_of(model_selection))),
         across(all_of(model_selection), ~ . / sum)) %>% 
  select(-sum)

4 PLOTS

4.1 Participant age

4.2 Participant gender

4.3 Answers per world

4.3.1 Function to create plot with images

4.3.2 Children

4.3.2.1 Overall

4.3.2.2 Separated by age

p1 = func_plot_with_images(data = df.choices %>% 
                             filter(age == 4),
                           model = df.predictions)

p2 = func_plot_with_images(data = df.choices %>% 
                             filter(age == 5),
                           model = df.predictions)

p3 = func_plot_with_images(data = df.choices %>% 
                             filter(age == 6),
                           model = df.predictions)

p4 = func_plot_with_images(data = df.choices %>% 
                             filter(age == 7),
                           model = df.predictions)

p5 = func_plot_with_images(data = df.choices %>% 
                             filter(age == 8),
                           model = df.predictions)
p1 + p2 + p3 + p4 + p5 + 
  plot_layout(ncol = 1,
              tag_level = "new") + 
  plot_annotation(tag_levels = "A")

4.3.3 Adults (Vision only)

4.3.4 Adults (Vision & Sound)

4.4 Model fits

4.4.1 Children

4.4.1.1 Per participant

4.4.1.2 Per age group

4.4.2 Adults

4.4.2.1 Per participant

df.plot = df.fits.adults %>% 
  pivot_longer(cols = -c(experiment, participant)) %>% 
  mutate(participant = as.factor(participant),
         name = factor(name,
                       levels = c("baseline", "matching",
                                  "adult_vision","adult_vision_sound"),
                       labels = c("baseline", "matching",
                                  "vision","vision & sound")))
ggplot(data = df.plot,
       mapping = aes(x = participant,
                     y = value,
                     fill = name)) + 
  geom_bar(position = "stack",
           stat = "identity",
           color = "black") + 
  facet_wrap(~ experiment,
             scales = "free_x") + 
  scale_fill_brewer(palette = "Set1") + 
  labs(y = "% of each model") + 
  theme(axis.text.y = element_blank(),
        axis.text.x = element_text(size = 10))

4.4.2.2 Per experiment

df.plot = df.fits.adults %>% 
  group_by(experiment) %>% 
  summarize(across(all_of(model_selection), ~ mean(.))) %>% 
  ungroup() %>% 
  pivot_longer(cols = -experiment) %>% 
  mutate(name = factor(name,
                       levels = c("baseline", "matching",
                                  "adult_vision","adult_vision_sound"),
                       labels = c("baseline", "matching",
                                  "vision","vision & sound")))
ggplot(data = df.plot,
       mapping = aes(x = experiment,
                     y = value,
                     fill = name)) + 
  geom_bar(position = "stack",
           stat = "identity",
           color = "black") + 
  scale_fill_brewer(palette = "Set1") + 
  labs(y = "% of each model") + 
  theme(axis.text.y = element_blank(),
        axis.title.x = element_blank())

4.5 Correct responses per world

4.6 Correct responses per participant

4.7 Proportion of correct responses over time

4.8 Session Info

R version 4.1.1 (2021-08-10)
Platform: x86_64-apple-darwin17.0 (64-bit)
Running under: macOS Big Sur 10.16

Matrix products: default
BLAS:   /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRblas.0.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

attached base packages:
[1] grid      stats     graphics  grDevices utils     datasets  methods  
[8] base     

other attached packages:
 [1] forcats_0.5.1    stringr_1.4.0    dplyr_1.0.7      purrr_0.3.4     
 [5] readr_2.0.1      tidyr_1.1.3      tibble_3.1.4     tidyverse_1.3.1 
 [9] patchwork_1.1.1  xtable_1.8-4     kableExtra_1.3.4 transport_0.12-2
[13] janitor_2.1.0    knitr_1.33       ggpubr_0.4.0     egg_0.4.5       
[17] ggplot2_3.3.5    gridExtra_2.3    png_0.1-7        readxl_1.3.1    

loaded via a namespace (and not attached):
 [1] fs_1.5.0           lubridate_1.7.10   bit64_4.0.5        RColorBrewer_1.1-2
 [5] webshot_0.5.2      httr_1.4.2         tools_4.1.1        backports_1.2.1   
 [9] utf8_1.2.2         R6_2.5.1           DBI_1.1.1          colorspace_2.0-2  
[13] withr_2.4.2        tidyselect_1.1.1   bit_4.0.4          curl_4.3.2        
[17] compiler_4.1.1     cli_3.0.1          rvest_1.0.1        xml2_1.3.2        
[21] labeling_0.4.2     bookdown_0.24      scales_1.1.1       systemfonts_1.0.2 
[25] digest_0.6.27      foreign_0.8-81     rmarkdown_2.10     svglite_2.0.0     
[29] rio_0.5.27         pkgconfig_2.0.3    htmltools_0.5.2    highr_0.9         
[33] dbplyr_2.1.1       fastmap_1.1.0      rlang_0.4.11       rstudioapi_0.13   
[37] farver_2.1.0       generics_0.1.0     jsonlite_1.7.2     vroom_1.5.4       
[41] zip_2.2.0          car_3.0-11         magrittr_2.0.1     Rcpp_1.0.7        
[45] munsell_0.5.0      fansi_0.5.0        abind_1.4-5        lifecycle_1.0.0   
[49] stringi_1.7.4      yaml_2.2.1         snakecase_0.11.0   carData_3.0-4     
[53] parallel_4.1.1     crayon_1.4.1       haven_2.4.3        hms_1.1.0         
[57] pillar_1.6.2       ggsignif_0.6.2     reprex_2.0.1       glue_1.4.2        
[61] evaluate_0.14      data.table_1.14.0  modelr_0.1.8       vctrs_0.3.8       
[65] tzdb_0.1.2         cellranger_1.1.0   gtable_0.3.0       assertthat_0.2.1  
[69] xfun_0.25          openxlsx_4.2.4     broom_0.7.9        rstatix_0.7.0     
[73] viridisLite_0.4.0  ellipsis_0.3.2